Text Mining — Cuenta de X del Museo del Prado

En este informe realizaremos un análisis lingüístico y de text mining sobre los tuits publicados por la cuenta del Museo del Prado entre 01-03-2024 y 30-06-2025 (dataset prado del fichero evaluacion.RData). El flujo incluirá: limpieza del texto preservando el punto para segmentación, anotación lingüística con udpipe (tokens, UPOS, lemas, dependencias), cálculo de términos más frecuentes, palabras clave mediante RAKE, PMI/colocaciones y frases nominales, extracción con TextRank, coocurrencias y correlaciones (incluyendo nombres propios cuando aporte valor), una exploración temática (pintores y exposiciones) y dos focos específicos (“Santo Domingo” y “Veronese”).

Finalmente, generaremos word embeddings con GloVe (corpus de lemas filtrado a NOUN/ADJ/PROPN), evaluaremos términos similares (“greco”, “ecce”, “tríptico”, “falomir”) y visualizaremos el espacio semántico con UMAP.

1.Librerías utilizadas

Usaremos un conjunto de paquetes que cubren el flujo completo:

•   tidyverse: manipulación de datos y gráficos (dplyr, ggplot2, readr).

•   lubridate: manejo de fechas (filtrado por rango temporal).

•   stringr: utilidades de cadenas para apoyar la limpieza.

•   janitor / skimr: chequeos y resúmenes exploratorios.

•   reactable: tablas interactivas en el informe HTML.

•   udpipe: análisis lingüístico (tokenización, UPOS, lemas, dependencias) y utilidades (frecuencias, DTM, coocurrencias).

•   textrank: TextRank para extracción de keywords.

•   widyr: correlaciones de términos a partir de DTM.

•   igraph / ggraph: redes de coocurrencias y visualización.

•   text2vec / Matrix: GloVe (embeddings) y manejo disperso.

•   uwot: UMAP para reducción de dimensionalidad y visualización.

•   rmdformats: plantilla readthedown para HTML con navegación lateral.
instalar_si_falta <- function(pkg) {
  if (!require(pkg, character.only = TRUE)) {
    install.packages(pkg, repos = "https://cloud.r-project.org")
    library(pkg, character.only = TRUE)
  }
}

paquetes <- c(
  "tidyverse","lubridate","stringr","janitor","skimr","reactable",
  "udpipe","textrank","widyr","igraph","ggraph",
  "text2vec","Matrix","uwot","rmdformats"
)

invisible(lapply(paquetes, instalar_si_falta))

1.1 Carga y exploración de datos

# === 1) Carga y comprobaciones básicas ===
load("evaluacion.RData")  # Carga: prado, reviews, documentos
cat("Objetos cargados:", paste(ls(), collapse = ", "), "\n")
## Objetos cargados: documentos, instalar_si_falta, paquetes, prado, reviews
# Chequeo rápido del dataset 'prado'
dim(prado)       # nº filas x columnas
## [1] 1469    3
str(prado)       # estructura
## 'data.frame':    1469 obs. of  3 variables:
##  $ fecha: POSIXct, format: "2025-06-30 15:32:21" "2025-06-30 15:27:16" ...
##  $ texto: chr  "\n#PradoEducación Visita descriptiva \"Maniera Veronese\", un recorrido guiado para personas ciegas o con baja "| __truncated__ "\nHello, you may explore our collection and past temporary exhibitions for free here: https://museodelprado.es/"| __truncated__ "Hola, no, se celebrará el 12 de julio. Saludos" "\nEl Museo del Prado presenta una muestra dedicada a Antonio Muñoz Degrain en la sala de exposiciones del XIX h"| __truncated__ ...
##  $ url  : chr  "https://x.com/museodelprado/status/1939708593005040033" "https://x.com/museodelprado/status/1939707315600466357" "https://x.com/museodelprado/status/1939635080328044565" "https://x.com/museodelprado/status/1939620506405405166" ...
head(prado, 5)   # primeras filas
##                 fecha
## 1 2025-06-30 15:32:21
## 2 2025-06-30 15:27:16
## 3 2025-06-30 10:40:14
## 4 2025-06-30 09:42:19
## 5 2025-06-30 08:38:41
##                                                                                                                                                                                                                                                                                                                 texto
## 1 \n#PradoEducación Visita descriptiva "Maniera Veronese", un recorrido guiado para personas ciegas o con baja visión y sus acompañantes a la exposición "Paolo Veronese (1528-1588)". Inscríbete aquí: https://museodelprado.es/recurso/9fbe0294-0ed8-44e8-9836-f31a069b18ef/e0c6f4d2-5b47-4d29-a619-4ac0300493b0…\n
## 2                                                                                                                                                                                  \nHello, you may explore our collection and past temporary exhibitions for free here: https://museodelprado.es/en/virtual-tours…\n
## 3                                                                                                                                                                                                                                                                      Hola, no, se celebrará el 12 de julio. Saludos
## 4                                                                  \nEl Museo del Prado presenta una muestra dedicada a Antonio Muñoz Degrain en la sala de exposiciones del XIX https://museodelprado.es/actualidad/noticia/el-museo-del-prado-presenta-una-muestra-dedicada/896f55f2-062c-83f8-056f-4fdb65d392f4…\n
## 5                                                                                                                                                                                                     Esta mañana presentamos a los medios de comunicación la exposición “El pintor Antonio Muñoz Degrain (1840-1924)
##                                                      url
## 1 https://x.com/museodelprado/status/1939708593005040033
## 2 https://x.com/museodelprado/status/1939707315600466357
## 3 https://x.com/museodelprado/status/1939635080328044565
## 4 https://x.com/museodelprado/status/1939620506405405166
## 5 https://x.com/museodelprado/status/1939604492351132147
summary(prado)   # resumen columnas
##      fecha                           texto               url           
##  Min.   :2024-01-02 08:51:00.00   Length:1469        Length:1469       
##  1st Qu.:2024-06-14 07:18:50.00   Class :character   Class :character  
##  Median :2024-10-22 10:47:50.00   Mode  :character   Mode  :character  
##  Mean   :2024-10-16 19:10:39.19                                        
##  3rd Qu.:2025-02-27 10:59:51.00                                        
##  Max.   :2025-06-30 15:32:21.00
if ("skimr" %in% rownames(installed.packages())) skimr::skim(prado)
Data summary
Name prado
Number of rows 1469
Number of columns 3
_______________________
Column type frequency:
character 2
POSIXct 1
________________________
Group variables None

Variable type: character

skim_variable n_missing complete_rate min max empty n_unique whitespace
texto 0 1 14 569 0 1295 0
url 0 1 54 54 0 1469 0

Variable type: POSIXct

skim_variable n_missing complete_rate min max median n_unique
fecha 0 1 2024-01-02 08:51:00 2025-06-30 15:32:21 2024-10-22 10:47:50 1469
# === 2) Vista interactiva inicial con reactable ===

# Copia segura
prado_vista <- prado

# Parseo de fecha a Date si fuera necesario
if (!inherits(prado_vista$fecha, "Date")) {
  prado_vista$fecha <- suppressWarnings(lubridate::as_date(prado_vista$fecha))
}

# Función para truncar texto en la vista
.trunc_txt <- function(x, n = 180) {
  x <- as.character(x)
  too_long <- nchar(x, allowNA = TRUE) > n
  x[too_long] <- paste0(substr(x[too_long], 1, n - 1), "…")
  x
}

# Data para la tabla (dejamos el texto completo en prado_vista para usarlo en "details")
tabla_prado <- dplyr::transmute(
  prado_vista,
  fecha,
  texto_corto = .trunc_txt(texto, 180),
  url
)
tabla_prado <- dplyr::arrange(tabla_prado, dplyr::desc(fecha))

# Tabla interactiva:
reactable::reactable(
  data = tabla_prado,
  searchable = TRUE,
  filterable = TRUE,
  pagination = FALSE,             # scroll continuo
  height = 520,
  defaultSorted = "fecha",
  defaultSortOrder = "desc",
  resizable = TRUE,               # columnas redimensionables
  defaultColDef = reactable::colDef(
    align = "left",
    headerClass = "header-bold",
    style = list(whiteSpace = "normal")  # permitir salto de línea
  ),
  columns = list(
    fecha = reactable::colDef(
      name = "Fecha",
      minWidth = 120,
      format = reactable::colFormat(date = TRUE)
    ),
    texto_corto = reactable::colDef(
      name = "Texto (truncado)",
      minWidth = 520
    ),
    url = reactable::colDef(
      name = "Enlace",
      minWidth = 120,
      html = TRUE,
      cell = function(value) {
        if (is.na(value) || value == "") return("")
        htmltools::tags$a(href = value, target = "_blank", "Abrir")
      }
    )
  ),
  details = function(index) {
    txt_full <- prado_vista$texto[index]
    htmltools::div(
      style = "padding: 12px; background: #fafafa; border-top: 1px solid #eee;",
      htmltools::tags$b("Texto completo:"),
      htmltools::tags$p(txt_full, style = "margin: 6px 0 0 0;")
    )
  },
  theme = reactable::reactableTheme(
    headerStyle = list(fontWeight = 600),
    borderColor = "#eee",
    cellPadding = "8px 10px"
  )
)

2. Filtrado temporal

En este paso filtramos los tuits a la ventana temporal del enunciado (01-03-2024 a 30-06-2025) y validamos el resultado con un recuento mensual. Esto nos asegura que trabajamos exactamente con el subconjunto requerido y nos da una primera visión de la actividad por meses.

# --- Filtrado temporal: 01-03-2024 a 30-06-2025 ---

# Aseguramos tipo Date
prado <- prado %>%
  mutate(fecha = lubridate::as_date(fecha))

# Ventana temporal del enunciado
fecha_ini <- lubridate::ymd("2024-03-01")
fecha_fin <- lubridate::ymd("2025-06-30")

prado_filtrado <- prado %>%
  filter(fecha >= fecha_ini, fecha <= fecha_fin)

# Comprobación rápida
cat("Registros totales en prado:", nrow(prado), "\n")
## Registros totales en prado: 1469
cat("Registros tras filtrar (", as.character(fecha_ini), " a ", as.character(fecha_fin), "): ", 
    nrow(prado_filtrado), "\n", sep = "")
## Registros tras filtrar (2024-03-01 a 2025-06-30): 1347
# --- Resumen mensual (nº de tuits por mes) ---
prado_mes <- prado_filtrado %>%
  mutate(mes = floor_date(fecha, unit = "month")) %>%
  count(mes, name = "n_tuits") %>%
  arrange(mes)

# Tabla interactiva con reactable
reactable::reactable(
  prado_mes,
  searchable = TRUE,
  pagination = FALSE,
  height = 360,
  defaultSorted = "mes",
  defaultSortOrder = "asc",
  defaultColDef = reactable::colDef(align = "left"),
  columns = list(
    mes = reactable::colDef(name = "Mes", format = reactable::colFormat(date = TRUE), minWidth = 140),
    n_tuits = reactable::colDef(name = "Nº de tuits", minWidth = 120)
  ),
  theme = reactable::reactableTheme(
    headerStyle = list(fontWeight = 600),
    borderColor = "#eee",
    cellPadding = "8px 10px",
    stripedColor = "#fafafa"
  )
)
# Vista breve de los tuits filtrados para validar contenido
.trunc_txt <- function(x, n = 160) {
  x <- as.character(x)
  too_long <- nchar(x, allowNA = TRUE) > n
  x[too_long] <- paste0(substr(x[too_long], 1, n - 1), "…")
  x
}

tabla_check <- prado_filtrado %>%
  transmute(
    fecha,
    texto_corto = .trunc_txt(texto, 160),
    url
  ) %>%
  arrange(desc(fecha)) %>%
  head(50)

reactable::reactable(
  tabla_check,
  searchable = TRUE,
  pagination = TRUE,
  defaultPageSize = 10,
  defaultSorted = "fecha",
  defaultSortOrder = "desc",
  columns = list(
    fecha = reactable::colDef(name = "Fecha", format = reactable::colFormat(date = TRUE), minWidth = 120),
    texto_corto = reactable::colDef(name = "Texto (truncado)", minWidth = 520),
    url = reactable::colDef(
      name = "Enlace",
      minWidth = 120,
      html = TRUE,
      cell = function(value) {
        if (is.na(value) || value == "") return("")
        htmltools::tags$a(href = value, target = "_blank", "Abrir")
      }
    )
  )
)

3. Limpieza de texto

En este paso realizamos un proceso de depuración del contenido textual de los tuits.
El objetivo es eliminar elementos que no aportan valor semántico al análisis y que podrían distorsionar los resultados posteriores (por ejemplo, menciones a usuarios, hashtags o URLs).

Para ello creamos una nueva columna llamada textmining, a partir del texto original, sobre la cual aplicamos las siguientes transformaciones:

  • Eliminación de menciones a usuarios de X (@usuario).
  • Eliminación de hashtags (#hashtag).
  • Eliminación de URLs y direcciones de correo electrónico.
  • Inserción de espacios en los casos en los que la puntuación va seguida de letras sin separación.
  • Conservación únicamente de letras, dígitos, espacios y signos de puntuación relevantes.
  • Normalización de espacios en blanco (reducción de espacios múltiples y eliminación de los espacios al inicio y al final).

De este modo obtenemos una versión limpia y homogénea del texto que nos servirá como base para el análisis lingüístico posterior (tokenización, lematización y extracción de palabras clave).

# === 3) Limpieza de texto en 'prado_filtrado' ===
# Creamos 'textmining' a partir de 'texto' y aplicamos las reglas del enunciado.

prado_filtrado$textmining <- prado_filtrado$texto
prado_filtrado$textmining <- gsub("@\\w+", "", prado_filtrado$textmining)                     # menciones
prado_filtrado$textmining <- gsub("#\\w+", "", prado_filtrado$textmining)                     # hashtags
prado_filtrado$textmining <- gsub("http[^[:blank:]]*", "", prado_filtrado$textmining)         # URLs
prado_filtrado$textmining <- gsub("\\w+@\\w+\\.\\w+", "", prado_filtrado$textmining)          # e-mails
prado_filtrado$textmining <- gsub("([.]|,|;|:)([[:alpha:]])", "\\1 \\2", prado_filtrado$textmining) # espacio tras puntuación
prado_filtrado$textmining <- gsub("[^[:alpha:][:digit:][:space:][:punct:]]*", "", prado_filtrado$textmining) # caracteres raros
prado_filtrado$textmining <- gsub("\\s{2,}", " ", prado_filtrado$textmining)                  # espacios múltiples
prado_filtrado$textmining <- trimws(prado_filtrado$textmining)                                # bordes

# Vista rápida (original vs limpio)
reactable::reactable(
  prado_filtrado |>
    dplyr::select(fecha, texto, textmining) |>
    head(15),
  searchable = TRUE,
  pagination = TRUE,
  defaultPageSize = 5,
  columns = list(
    fecha = reactable::colDef(name = "Fecha"),
    texto = reactable::colDef(name = "Texto original", minWidth = 420),
    textmining = reactable::colDef(name = "Texto limpio", minWidth = 420)
  )
)

4. Análisis lingüístico

Una vez limpio el texto de los tuits, realizamos un análisis lingüístico utilizando el paquete udpipe.
Este análisis nos permite descomponer el texto en tokens (palabras individuales), asignarles su categoría gramatical (sustantivo, adjetivo, verbo, nombre propio, etc.), obtener el lema de cada palabra y establecer las relaciones de dependencia sintáctica entre ellas.

Estos procesos son fundamentales porque nos permiten:
- Trabajar con la forma canónica de las palabras (lemas).
- Filtrar únicamente las categorías de interés (sustantivos, adjetivos, nombres propios).
- Analizar el texto a un nivel más estructurado y semánticamente significativo.

El resultado será un dataframe enriquecido, en el que cada fila corresponde a un token con sus anotaciones lingüísticas.

# --- Modelo de idioma para udpipe (Español) ---

# Descarga del modelo (solo la primera vez, luego comentamos esta línea)
# udpipe_download_model(language = "spanish")

# Carga del modelo ya descargado en el directorio de trabajo
modelo <- udpipe_load_model("spanish-gsd-ud-2.5-191206.udpipe")

# Confirmación
print(modelo)
## $file
## [1] "spanish-gsd-ud-2.5-191206.udpipe"
## 
## $model
## <pointer: 0x14366b000>
## 
## attr(,"class")
## [1] "udpipe_model"
# --- 4.2 Anotación lingüística con udpipe (versión base) ---

# Anotamos el texto limpio
anotaciones <- udpipe_annotate(
  object = modelo,
  x      = prado_filtrado$textmining,
  doc_id = as.character(prado_filtrado$url)
)

# Guardamos dos objetos por claridad:
anotaciones_df_raw <- as.data.frame(anotaciones)  # copia cruda (referencia)
anotaciones_df     <- anotaciones_df_raw          # objeto de trabajo SIN filtrar stopwords

# Vista rápida
reactable::reactable(
  head(anotaciones_df, 50),
  searchable = TRUE,
  defaultPageSize = 10,
  highlight = TRUE
)

5. Términos más frecuentes

A partir de las anotaciones lingüísticas obtenidas con udpipe, seleccionamos las categorías gramaticales que resultan más relevantes para este análisis: sustantivos (NOUN), adjetivos (ADJ) y nombres propios (PROPN).
El objetivo es identificar qué términos aparecen con mayor frecuencia en los tuits del Museo del Prado durante el periodo de estudio.

De esta forma, obtenemos una primera aproximación al vocabulario predominante, que nos servirá de base para posteriores análisis de palabras clave, coocurrencias y correlaciones.

# --- 5) Términos más frecuentes (NOUN/ADJ/PROPN)---
terminos <- subset(anotaciones_df, upos %in% c("NOUN", "ADJ", "PROPN"))

# Aseguramos lemas en minúscula y sin NA
lemmas <- tolower(terminos$lemma)
lemmas <- lemmas[!is.na(lemmas) & nzchar(lemmas)]

# Frecuencias (txt_freq devuelve key, freq, freq_pct)
frecuencias <- txt_freq(lemmas)

# Tabla interactiva (Top 50)
reactable::reactable(
  head(frecuencias, 50),
  searchable = TRUE,
  pagination = TRUE,
  defaultPageSize = 10,
  defaultSorted = "freq",
  defaultSortOrder = "desc",
  columns = list(
    key = reactable::colDef(name = "Término"),
    freq = reactable::colDef(name = "Frecuencia"),
    freq_pct = reactable::colDef(
      name = "Frecuencia (%)",
      format = reactable::colFormat(percent = TRUE, digits = 2)
    )
  )
)
# Visualización básica (Top 20)
frecuencias %>%
  head(20) %>%
  ggplot(aes(x = reorder(key, freq), y = freq)) +
  geom_col(fill = "#3AAFA9") +
  coord_flip() +
  labs(
    title = "Top 20 términos más frecuentes",
    x = "Término",
    y = "Frecuencia"
  ) +
  theme_minimal(base_size = 14)

6. Palabras clave

En esta sección aplicamos diferentes métodos de extracción de palabras clave sobre los tuits del Museo del Prado. El objetivo es identificar términos o combinaciones de términos especialmente representativos del corpus, más allá de su mera frecuencia individual.

Los métodos utilizados son los siguientes:

  • RAKE (Rapid Automatic Keyword Extraction): identifica palabras clave a partir de la frecuencia de aparición de términos y sus coocurrencias.
  • PMI (Pointwise Mutual Information) / colocaciones: detecta combinaciones de palabras que ocurren juntas con mayor frecuencia de lo esperado.
  • Extracción de frases nominales: obtiene secuencias de sustantivos y adjetivos que funcionan como unidades significativas (ej. pintura flamenca).
  • TextRank: construye una red de palabras y aplica el algoritmo PageRank para identificar secuencias relevantes.

Cada técnica aporta una perspectiva complementaria, enriqueciendo el análisis de las temáticas presentes en los tuits.

# --- 6.1) RAKE (versión base, sin exclusiones) ---

# Usamos la anotación COMPLETA (sin filtrar lemas): anotaciones_df_raw
# Si no existe cambia a 'anotaciones_df'
x_base <- if (exists("anotaciones_df_raw")) anotaciones_df_raw else anotaciones_df

# RAKE sobre lemas, agrupado por documento, con NOUN/ADJ/PROPN como relevantes
kw_rake_base <- keywords_rake(
  x        = x_base,
  term     = "lemma",
  group    = "doc_id",
  relevant = x_base$upos %in% c("NOUN","ADJ","PROPN"),
  n_min    = 2
)

# Ordenamos por score RAKE descendente y mostramos top 30
kw_rake_base <- kw_rake_base[order(-kw_rake_base$rake), ]

reactable::reactable(
  head(kw_rake_base, 30),
  searchable = TRUE,
  pagination = TRUE,
  defaultPageSize = 10,
  defaultSorted = "rake",
  defaultSortOrder = "desc"
)
# --- PMI / Colocaciones con udpipe (sin argumento 'measure') ---

# 1) Filtramos categorías relevantes (NOUN, ADJ, PROPN)
terms_relev <- subset(
  anotaciones_df,
  upos %in% c("NOUN", "ADJ", "PROPN")
)

# 2) Colocaciones: mínimo de coocurrencias conjuntas
kw_coll <- keywords_collocation(
  x = terms_relev,
  term = "lemma",
  group = "doc_id",
  n_min = 5   # ajustamos más/menos estrictos
)

# 3) Orden robusto: por 'pmi' si existe; si no, por 'freq'
orden_col <- if ("pmi" %in% names(kw_coll)) "pmi" else "freq"
kw_coll_ord <- kw_coll[order(-kw_coll[[orden_col]]), ]

# 4) Vista interactiva top 30
reactable::reactable(
  head(kw_coll_ord, 30),
  searchable = TRUE,
  pagination = TRUE,
  defaultPageSize = 10,
  defaultSorted = orden_col,
  defaultSortOrder = "desc",
  columns = list(
    keyword = reactable::colDef(name = "Colocación"),
    freq = reactable::colDef(name = "Frecuencia"),
    pmi = if ("pmi" %in% names(kw_coll)) reactable::colDef(name = "PMI") else NULL
  )
)
# --- Extracción de frases nominales ---
# Creamos la columna con la etiqueta de frase
anotaciones_df$phrase_tag <- as_phrasemachine(anotaciones_df$upos, type = "upos")

# Patrón: secuencia de adjetivos y sustantivos terminada en sustantivo
kw_phrases <- keywords_phrases(
  x = anotaciones_df$phrase_tag,
  term = tolower(anotaciones_df$token),
  pattern = "(A|N)*N(P+D*(A|N)*N)*",  # patrón de frases nominales
  is_regex = TRUE, detailed = FALSE
)

# Filtramos frases frecuentes
kw_phrases <- subset(kw_phrases, ngram > 1 & freq > 3)

reactable::reactable(
  head(kw_phrases[order(-kw_phrases$freq), ], 30),
  searchable = TRUE,
  defaultSorted = "freq",
  defaultSortOrder = "desc"
)
# --- TextRank (versión robusta para distintas salidas del paquete) ---

# 1) Máscara de términos relevantes
rel_mask <- anotaciones_df$upos %in% c("NOUN", "ADJ", "PROPN")

# 2) Ejecutamos TextRank
kw_tr_obj <- textrank::textrank_keywords(
  x = anotaciones_df$lemma,
  relevant = rel_mask,
  sep = " "
)

# 3) Pasamos a data.frame y normalizamos nombres de columnas
df_tr <- as.data.frame(kw_tr_obj$keywords)

# Si la columna de texto no se llama 'keyword',renombramos
if (!"keyword" %in% names(df_tr) && "term" %in% names(df_tr)) {
  names(df_tr)[names(df_tr) == "term"] <- "keyword"
}

# 4) Elegimos la mejor columna disponible para ordenar
sort_col <- dplyr::case_when(
  "textrank_score" %in% names(df_tr) ~ "textrank_score",
  "textrank" %in% names(df_tr)       ~ "textrank",
  "freq" %in% names(df_tr)           ~ "freq",
  TRUE ~ names(df_tr)[2]  # fallback: la segunda columna que exista
)

df_tr <- df_tr[order(-df_tr[[sort_col]]), ]

# 5) Definimos columnas para reactable según existan
cols <- list(keyword = reactable::colDef(name = "Keyword"))
if ("textrank_score" %in% names(df_tr)) cols$textrank_score <- reactable::colDef(name = "Score")
if ("textrank" %in% names(df_tr))       cols$textrank       <- reactable::colDef(name = "Score")
if ("freq" %in% names(df_tr))           cols$freq           <- reactable::colDef(name = "Frecuencia")

# 6) Tabla interactiva
reactable::reactable(
  head(df_tr, 30),
  searchable = TRUE,
  pagination = TRUE,
  defaultPageSize = 10,
  defaultSorted = sort_col,
  defaultSortOrder = "desc",
  columns = cols
)

Conclusiones del punto 6. Palabras clave

Los cuatro métodos aplicados han permitido obtener perspectivas complementarias:

  • RAKE ha identificado principalmente nombres propios y entidades (artistas, instituciones, premios).
  • PMI/colocaciones ha resaltado pares de palabras significativas, donde aparecen de forma destacada pintores clásicos y contemporáneos.
  • Frases nominales han aportado contexto temático, detectando expresiones frecuentes relacionadas con conferencias, exposiciones y periodos artísticos (ej. siglo de oro, santo domingo).
  • TextRank ha confirmado los términos nucleares del discurso del Museo del Prado: prado, museo, arte, exposición, obra, españa.

En conjunto, estos métodos refuerzan la idea de que la comunicación de la cuenta gira en torno a artistas concretos, exposiciones relevantes y ejes temáticos clásicos de la historia del arte, con especial presencia del Siglo de Oro.

7. Relaciones entre términos

En este apartado analizamos las relaciones entre palabras en los tuits del Museo del Prado.
Más allá de las frecuencias individuales o de las palabras clave, nos interesa estudiar qué términos aparecen juntos en los textos y cómo se correlacionan entre sí.

  • Coocurrencias: cuentan cuántas veces dos términos aparecen en el mismo contexto (mismo documento, misma oración o cercanos en el texto).
  • Correlaciones: miden el grado en que dos términos aparecen juntos de forma consistente, incluso aunque no sean muy frecuentes de manera individual.

Este análisis nos permite descubrir asociaciones relevantes entre artistas, exposiciones y conceptos, proporcionando una base sólida para extraer temáticas y redes de significado.

# --- Selección de términos relevantes ---
terminos_rel <- subset(
  anotaciones_df,
  upos %in% c("NOUN", "ADJ", "PROPN")
)

# === 7.1 Coocurrencias ===
# Coocurrencias por documento (tuit)
cooc_doc <- cooccurrence(
  x = terminos_rel,
  term = "lemma",
  group = "doc_id"
)

# Coocurrencias por proximidad (skipgram = 1 → incluye la palabra siguiente)
cooc_skip <- cooccurrence(
  x = terminos_rel$lemma,
  skipgram = 1
)

# Vista top 30 coocurrencias por documento
reactable::reactable(
  head(cooc_doc[order(-cooc_doc$cooc, cooc_doc$term1), ], 30),
  searchable = TRUE,
  defaultSorted = "cooc",
  defaultSortOrder = "desc"
)
# === 7.2 Correlaciones ===
# Identificador único por oración
anotaciones_df$id_sent <- unique_identifier(anotaciones_df, fields = c("doc_id", "sentence_id"))

# Construcción de matriz documento-término por oración
dtf <- document_term_frequencies(
  x = subset(anotaciones_df, upos %in% c("NOUN", "ADJ", "PROPN")),
  document = "id_sent",
  term = "lemma"
)
dtm <- document_term_matrix(dtf)

# Eliminamos términos muy poco frecuentes (minfreq = 7 para mayor estabilidad)
dtm <- dtm_remove_lowfreq(dtm, minfreq = 7)

# Matriz de correlación de términos (Pearson)
corr_mat <- dtm_cor(dtm)

# Convertimos en dataframe de coocurrencia
corr_df <- as_cooccurrence(corr_mat)

# Filtramos correlaciones altas (ejemplo: > 0.25)
corr_df <- subset(corr_df, term1 < term2 & abs(cooc) > 0.25)
corr_df <- corr_df[order(-corr_df$cooc), ]

# Vista top 30 correlaciones
reactable::reactable(
  head(corr_df, 30),
  searchable = TRUE,
  defaultSorted = "cooc",
  defaultSortOrder = "desc"
)
# --- Visualización de coocurrencias con igraph/ggraph (con color) ---

# Selección de coocurrencias fuertes
cooc_top <- subset(cooc_doc, cooc >= 15)

# Grafo
grafo <- igraph::graph_from_data_frame(cooc_top)

# Calculamos grado de cada nodo (nº de conexiones)
V(grafo)$grado <- igraph::degree(grafo)

# Dibujo con color en función del grado
ggraph::ggraph(grafo, layout = "fr") +
  ggraph::geom_edge_link(aes(width = cooc), alpha = 0.4, colour = "grey70") +
  ggraph::geom_node_point(aes(size = grado, color = grado)) +
  ggraph::geom_node_text(aes(label = name), repel = TRUE, size = 4) +
  scale_edge_width(range = c(0.3, 2)) +
  scale_color_gradient(low = "#3AAFA9", high = "#FE6F5E") +
  labs(title = "Red de coocurrencias (términos relevantes)") +
  theme_void()

## Conclusiones coocurrencias y correlaciones

El análisis de coocurrencias y correlaciones muestra que:

  • Los términos más centrales en la red son museo, prado, obra, arte, que actúan como ejes estructurales del discurso.
  • Se observan asociaciones temáticas significativas, como domingo – greco – antiguo, escultura – siglo, o españa – social.
  • En la periferia aparecen subtemas concretos vinculados a artistas (Zurbarán, Veronese, Rubens), a botánica (cidra – naranjo) y a actividades académicas (universidad complutense, conferencia).

En conjunto, estas relaciones confirman que la comunicación de la cuenta combina un núcleo institucional muy marcado con referencias específicas a artistas, exposiciones y proyectos culturales.

8. Clasificación temática exploratoria

Identificación de pintores y exposiciones

Examinando las tablas de coocurrencias y correlaciones obtenidas en el punto anterior, podemos identificar claramente varios pintores:

  • El Greco, asociado a los términos domingo y antiguo.
  • Goya y Velázquez, en relación con obra, muestra y siglo de oro.
  • Rubens, vinculado a barroco y pintura.
  • Veronese, relacionado con exposición y catálogo.
  • Caravaggio y Madrazo, presentes en cadenas menores.

En cuanto a exposiciones y temáticas, destacan:

  • El periodo Siglo de Oro como eje central.
  • Referencias a catálogo, proyecto y transformación como actividades institucionales.
  • La mención de muestra y conferencia en contexto académico y divulgativo.

A modo ilustrativo, algunas relaciones extraídas son:

  • greco – domingo – antiguo

  • rubens – barroco – pintura

  • veronese – exposición – catálogo

  • Por último, seleccionamos los tuits que contienen “Santo Domingo” y “Veronese”, mostrando los cinco más antiguos y sus coocurrencias asociadas.

# ------------------------------
# 8.4 Búsquedas focalizadas (Santo Domingo / Veronese)
# ------------------------------

# Reconstruimos coocurrencias normalizadas (sustituye a 'tmp')
cooc_src <- if (exists("cooc_doc_df")) cooc_doc_df else cooc_doc
cooc_norm <- as.data.frame(cooc_src)
cooc_norm$term1 <- tolower(cooc_norm$term1)
cooc_norm$term2 <- tolower(cooc_norm$term2)

htmltools::h3("Tuits con 'Santo Domingo' (5 primeros por fecha)")

Tuits con 'Santo Domingo' (5 primeros por fecha)

santo_dom <- prado_filtrado[grepl("Santo Domingo", prado_filtrado$texto, ignore.case = TRUE), ]
santo_dom <- santo_dom[order(santo_dom$fecha), , drop = FALSE]
if (nrow(santo_dom) > 0) {
  reactable::reactable(
    utils::head(santo_dom[, c("fecha","texto","url")], 5),
    searchable = TRUE,
    defaultSorted = "fecha",
    defaultSortOrder = "asc",
    columns = list(
      fecha = reactable::colDef(name = "Fecha"),
      texto = reactable::colDef(name = "Texto", minWidth = 560),
      url   = reactable::colDef(
        name = "Enlace",
        minWidth = 120,
        html = TRUE,
        cell = function(value) if (!is.na(value) && nzchar(value)) htmltools::tags$a(href = value, target = "_blank", "Abrir")
      )
    )
  )
} else {
  htmltools::p("No se han encontrado tuits con 'Santo Domingo' en el intervalo analizado.")
}
htmltools::h3("Coocurrencias relacionadas con 'Santo'/'Domingo'")

Coocurrencias relacionadas con 'Santo'/'Domingo'

cooc_santo <- cooc_norm[
  cooc_norm$term1 %in% c("santo","domingo") | cooc_norm$term2 %in% c("santo","domingo"),
  , drop = FALSE
]
if (nrow(cooc_santo) > 0) {
  cooc_santo <- cooc_santo[order(-cooc_santo$cooc), , drop = FALSE]
  reactable::reactable(
    utils::head(cooc_santo, 30),
    searchable = TRUE,
    defaultSorted = "cooc",
    defaultSortOrder = "desc"
  )
} else {
  htmltools::p("No se han encontrado coocurrencias para 'Santo'/'Domingo'.")
}
htmltools::h3("Tuits con 'Veronese' (5 primeros por fecha)")

Tuits con 'Veronese' (5 primeros por fecha)

veronese <- prado_filtrado[grepl("Veronese", prado_filtrado$texto, ignore.case = TRUE), ]
veronese <- veronese[order(veronese$fecha), , drop = FALSE]
if (nrow(veronese) > 0) {
  reactable::reactable(
    utils::head(veronese[, c("fecha","texto","url")], 5),
    searchable = TRUE,
    defaultSorted = "fecha",
    defaultSortOrder = "asc"
  )
} else {
  htmltools::p("No se han encontrado tuits con 'Veronese' en el intervalo analizado.")
}
htmltools::h3("Coocurrencias relacionadas con 'Veronese'")

Coocurrencias relacionadas con 'Veronese'

cooc_veronese <- cooc_norm[
  cooc_norm$term1 == "veronese" | cooc_norm$term2 == "veronese",
  , drop = FALSE
]
if (nrow(cooc_veronese) > 0) {
  cooc_veronese <- cooc_veronese[order(-cooc_veronese$cooc), , drop = FALSE]
  reactable::reactable(
    utils::head(cooc_veronese, 30),
    searchable = TRUE,
    defaultSorted = "cooc",
    defaultSortOrder = "desc"
  )
} else {
  htmltools::p("No se han encontrado coocurrencias para 'Veronese'.")
}

9. Word embeddings con GloVe y visualización con UMAP

Entrenamos embeddings con GloVe a partir de los tuits, usando lemas y filtrando por NOUN/ADJ/PROPN.
El corpus se organiza por documento (cada tuit es un documento), se crea la matriz de coocurrencias (TCM), se ajusta GloVe con una configuración robusta y, a partir de los vectores resultantes, se: - consultan similitudes para greco, ecce, tríptico, falomir, y
- proyecta un subconjunto de términos con UMAP para inspeccionar la estructura semántica.

De este modo, pasamos de un análisis estadístico de frecuencias y coocurrencias a una representación continua de las palabras, que captura relaciones más sutiles de proximidad semántica.

library(ggplot2)
suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(ggrepel))

# --- 9.1 Tokens por documento ---
df_tokens <- anotaciones_df %>%
  filter(upos %in% c("NOUN","ADJ","PROPN"), !is.na(lemma), nzchar(lemma)) %>%
  mutate(lemma = tolower(lemma)) %>%
  select(doc_id, lemma)

if (!nrow(df_tokens)) {
  warning("No hay tokens válidos (NOUN/ADJ/PROPN) para entrenar GloVe. Revisa el filtrado temporal.")
}

tokens_by_doc <- split(df_tokens$lemma, df_tokens$doc_id)
it <- itoken(tokens_by_doc, progressbar = FALSE)

# --- 9.2 Vocabulario + pruning adaptativo (sin abortar) ---
v0 <- create_vocabulary(it)

prune_try <- function(v, tc_min, dp_max) {
  out <- try(prune_vocabulary(v, term_count_min = tc_min, doc_proportion_max = dp_max), silent = TRUE)
  if (inherits(out, "try-error")) return(v) else return(out)
}

vocab <- v0
if (!is.null(vocab$vocab) && is.data.frame(vocab$vocab)) {
  # intento 1
  v1 <- prune_try(v0, 5, 0.5)
  if (!is.null(v1$vocab) && nrow(v1$vocab) >= 50) vocab <- v1 else {
    # intento 2
    v2 <- prune_try(v0, 3, 0.7)
    if (!is.null(v2$vocab) && nrow(v2$vocab) >= 30) vocab <- v2 else {
      # intento 3
      v3 <- prune_try(v0, 2, 0.9)
      if (!is.null(v3$vocab) && nrow(v3$vocab) >= 10) vocab <- v3 else {
        # fallback: sin pruning
        vocab <- v0
        message("Pruning muy restrictivo; se usa vocabulario sin podar.")
      }
    }
  }
} else {
  vocab <- v0
}

if (is.null(vocab$vocab) || !is.data.frame(vocab$vocab) || nrow(vocab$vocab) == 0) {
  # Último recurso: seguimos igualmente con v0; si aún así no hay términos, salimos con aviso
  vocab <- v0
  if (is.null(vocab$vocab) || !is.data.frame(vocab$vocab) || nrow(vocab$vocab) == 0) {
    warning("Vocabulario vacío incluso sin pruning. Continúo sin UMAP global y solo similitudes si es posible.")
  }
}

vectorizer <- vocab_vectorizer(vocab)
tcm <- create_tcm(it, vectorizer, skip_grams_window = 5)

# --- 9.3 GloVe (con fallback estable) ---
fit_glove_safe <- function(tcm, rank = 50, x_max = 10, lr = 0.05, n_iter = 20) {
  glove <- GlobalVectors$new(rank = rank, x_max = x_max, learning_rate = lr)
  wv_main <- glove$fit_transform(tcm, n_iter = n_iter, convergence_tol = 0.01)
  wv_ctx  <- glove$components
  wv_main + t(wv_ctx)
}

word_vectors <- NULL
if (!is.null(tcm) && length(tcm@x) > 0) {
  word_vectors <- try(fit_glove_safe(tcm, rank = 50, x_max = 10, lr = 0.05, n_iter = 20), silent = TRUE)
  if (inherits(word_vectors, "try-error") || is.null(word_vectors)) {
    word_vectors <- fit_glove_safe(tcm, rank = 30, x_max = 10, lr = 0.015, n_iter = 25)
  }
} else {
  warning("TCM vacía; no se puede entrenar GloVe.")
}
## INFO  [16:43:22.086] epoch 1, loss 0.2507
## INFO  [16:43:22.111] epoch 2, loss 0.1730
## INFO  [16:43:22.128] epoch 3, loss 0.1438
## INFO  [16:43:22.143] epoch 4, loss 0.1244
## INFO  [16:43:22.158] epoch 5, loss 0.1099
## INFO  [16:43:22.172] epoch 6, loss 0.0985
## INFO  [16:43:22.186] epoch 7, loss 0.0891
## INFO  [16:43:22.200] epoch 8, loss 0.0812
## INFO  [16:43:22.214] epoch 9, loss 0.0745
## INFO  [16:43:22.228] epoch 10, loss 0.0687
## INFO  [16:43:22.242] epoch 11, loss 0.0637
## INFO  [16:43:22.256] epoch 12, loss 0.0593
## INFO  [16:43:22.270] epoch 13, loss 0.0554
## INFO  [16:43:22.284] epoch 14, loss 0.0519
## INFO  [16:43:22.299] epoch 15, loss 0.0488
## INFO  [16:43:22.313] epoch 16, loss 0.0461
## INFO  [16:43:22.327] epoch 17, loss 0.0435
## INFO  [16:43:22.341] epoch 18, loss 0.0412
## INFO  [16:43:22.355] epoch 19, loss 0.0392
## INFO  [16:43:22.369] epoch 20, loss 0.0372
# --- 9.4 Similitudes con términos clave ---
terminos_clave <- c("greco","ecce","tríptico","falomir")
if (!is.null(word_vectors)) {
  cat("\n=== Similitudes (cosine) con términos clave ===\n")
  for (t in terminos_clave) {
    if (t %in% rownames(word_vectors)) {
      sim <- sim2(word_vectors, word_vectors[t, , drop = FALSE], method = "cosine", norm = "l2")[,1]
      sim <- sort(sim, decreasing = TRUE)
      simil_top <- head(sim[names(sim) != t], 10)
      cat("\n->", t, "\n")
      print(round(simil_top, 3))
    } else {
      cat("\n-> Aviso: término no encontrado en vocabulario:", t, "\n")
    }
  }
} else {
  message("Sin word_vectors: se omite la sección de similitudes.")
}
## 
## === Similitudes (cosine) con términos clave ===
## 
## -> greco 
##       santo     domingo     antiguo  monasterio      toledo  antigüedad 
##       0.807       0.649       0.595       0.545       0.509       0.467 
##     acogida        reni      ajuste instalación 
##       0.460       0.458       0.448       0.438 
## 
## -> ecce 
##                homo          caravaggio              gaspar              fisher 
##               0.774               0.550               0.452               0.420 
## multiinstrumentista               mejor         adquisición            estampas 
##               0.408               0.408               0.403               0.394 
##           categoría             oficina 
##               0.374               0.372 
## 
## -> tríptico 
##        jardín       android       delicia         bosco descargártela 
##         0.617         0.478         0.476         0.476         0.437 
##        master      preciado    interesado     caballero     juramento 
##         0.414         0.409         0.405         0.389         0.381 
## 
## -> falomir 
##    miguel  director   cristal kilómetro   fortuna   soledad  glosario    carnal 
##     0.752     0.665     0.462     0.420     0.394     0.387     0.385     0.384 
##     ángel   dibujos 
##     0.380     0.378
# Comunes: tabla de frecuencia y términos presentes
freq_tbl <- vocab$vocab
present_terms <- if (!is.null(word_vectors)) intersect(freq_tbl$term, rownames(word_vectors)) else character(0)

# 9.5a UMAP global (forzar print)
min_global <- 20
if (length(present_terms) >= min_global) {
  freq_tbl <- freq_tbl[order(-freq_tbl$term_count), , drop = FALSE]
  top_n <- min(300, length(present_terms))
  cand_global <- intersect(freq_tbl$term, present_terms)[1:top_n]

  mat_g <- word_vectors[cand_global, , drop = FALSE]
  set.seed(123)
  um_g <- uwot::umap(mat_g, n_neighbors = 15, min_dist = 0.1, metric = "cosine")

  df_umap_g <- data.frame(x = um_g[,1], y = um_g[,2], term = rownames(mat_g))
  p_global <- ggplot(df_umap_g, aes(x, y, label = term)) +
    geom_point(alpha = 0.6) +
    ggrepel::geom_text_repel(max.overlaps = 20, size = 3) +
    labs(title = "UMAP global de embeddings GloVe (términos frecuentes)") +
    theme_minimal(base_size = 14)
  print(p_global)  # <- forzamos la impresión
} else {
  message("UMAP global omitido (términos presentes < ", min_global, ").")
}

# 9.5b UMAP enfocado (forzar print + diagnóstico)
terminos_clave <- c("greco","ecce","tríptico","falomir")
focus_keys <- if (!is.null(word_vectors)) terminos_clave[terminos_clave %in% rownames(word_vectors)] else character(0)

cat("\n[Diagnóstico UMAP enfocado] claves presentes:", paste(focus_keys, collapse = ", "), "\n")
## 
## [Diagnóstico UMAP enfocado] claves presentes: greco, ecce, tríptico, falomir
if (length(focus_keys) > 0) {
  vecinos <- c()
  for (t in focus_keys) {
    sim <- sim2(word_vectors, word_vectors[t, , drop = FALSE], method = "cosine", norm = "l2")[,1]
    sim <- sort(sim, decreasing = TRUE)
    vecinos_t <- names(head(sim[names(sim) != t], 20))
    vecinos <- c(vecinos, t, vecinos_t)
  }
  cand_focus <- unique(vecinos)
  cand_focus <- intersect(cand_focus, rownames(word_vectors))
  cat("[Diagnóstico] términos a proyectar (focus):", length(cand_focus), "\n")

  if (length(cand_focus) >= 10) {
    mat_f <- word_vectors[cand_focus, , drop = FALSE]
    set.seed(123)
    um_f <- uwot::umap(mat_f, n_neighbors = 10, min_dist = 0.05, metric = "cosine")
    df_umap_f <- data.frame(x = um_f[,1], y = um_f[,2], term = rownames(mat_f))

    p_focus <- ggplot(df_umap_f, aes(x, y, label = term)) +
      geom_point(alpha = 0.7) +
      ggrepel::geom_text_repel(max.overlaps = 40, size = 3) +
      labs(title = "UMAP enfocado (vecinos de greco / ecce / tríptico / falomir)") +
      theme_minimal(base_size = 14)
    print(p_focus)  # <- forzamos la impresión
  } else {
    message("UMAP enfocado omitido: vecinos insuficientes (", length(cand_focus), ").")
  }
} else {
  message("UMAP enfocado omitido: ninguna clave está en el vocabulario.")
}
## [Diagnóstico] términos a proyectar (focus): 82

Conclusiones Word embeddings

El modelo GloVe entrenado sobre el corpus refleja relaciones semánticas relevantes entre los términos analizados:

  • greco aparece fuertemente vinculado a santo, antiguo, monasterio, domingo, lo que confirma la asociación del pintor con el ámbito religioso e histórico.
  • ecce se asocia principalmente a homo (fórmula “Ecce Homo”) y también a caravaggio, reforzando la relación iconográfica.
  • tríptico se relaciona con jardín, zarzuela, bosco, delicia, en clara alusión al Tríptico de El Bosco y sus contextos expositivos.
  • falomir (exdirector del Prado) se vincula a miguel, director, bénédicte, compositor, cultura, mostrando su contexto institucional y cultural.

La proyección UMAP enfocada con 82 términos alrededor de estas claves evidencia clústeres diferenciados que agrupan: - El contexto religioso e histórico (greco, santo, monasterio, domingo).
- La dimensión artística y expositiva (tríptico, bosco, jardín, delicia).
- La dimensión institucional y académica (falomir, director, cultura).

En conjunto, los embeddings permiten ir más allá de las coocurrencias y frecuencias, mostrando un espacio semántico continuo donde los términos cercanos en el discurso del Museo del Prado aparecen también próximos en el mapa vectorial.